home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 June / CHIP Haziran 2001.iso / prog / haziran / 19 / setup.exe / data.z / spkr_lib.bas < prev    next >
BASIC Source File  |  2001-04-11  |  5KB  |  143 lines
  1. Attribute VB_Name = "spkr_lib"
  2. '////////////////////////////////////////////////////////////////
  3. '// File - spkr_lib.bas
  4. '//
  5. '// This application plays a tone to the speaker, and is
  6. '// controlled via a graphical user interface - skprGUI.frm
  7. '// The speaker is accessed directly on the motherboard, using
  8. '// WinDriver functions.
  9. '//
  10. '////////////////////////////////////////////////////////////////
  11. Option Explicit
  12.  
  13. Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
  14.  
  15. Const SPEAKER_IO_42 = 0
  16. Const SPEAKER_IO_43 = 1
  17. Const SPEAKER_IO_61 = 2
  18. Const SPEAKER_ITEMS = 3
  19. Const SPEAKER_IO_ADDR42 = &H42
  20. Const SPEAKER_IO_ADDR43 = &H43
  21. Const SPEAKER_IO_ADDR61 = &H61
  22.  
  23. Const bit0 As Long = &H1
  24. Const bit1 As Long = &H2
  25.  
  26. Type SPEAKER_HANDLE
  27.    hWD As Long
  28.    cardReg As WD_CARD_REGISTER
  29. End Type
  30.  
  31. 'this string is set to an error message, if one occurs
  32. Public SPEAKER_ErrorString   As String
  33.  
  34. Sub SPEAKER_SetCardElements(hSPEAKER As SPEAKER_HANDLE)
  35.  ' internal function used by SPEAKER_Open()
  36.     hSPEAKER.cardReg.Card.dwItems = SPEAKER_ITEMS
  37.           ' SPEAKER IO range
  38.     hSPEAKER.cardReg.Card.Item(SPEAKER_IO_42).Item = ITEM_IO
  39.     hSPEAKER.cardReg.Card.Item(SPEAKER_IO_42).fNotSharable = False
  40.     hSPEAKER.cardReg.Card.Item(SPEAKER_IO_42).dw1 = SPEAKER_IO_ADDR42
  41.     hSPEAKER.cardReg.Card.Item(SPEAKER_IO_42).dw2 = 1
  42.     hSPEAKER.cardReg.Card.Item(SPEAKER_IO_43).Item = ITEM_IO
  43.     hSPEAKER.cardReg.Card.Item(SPEAKER_IO_43).fNotSharable = False
  44.     hSPEAKER.cardReg.Card.Item(SPEAKER_IO_43).dw1 = SPEAKER_IO_ADDR43
  45.     hSPEAKER.cardReg.Card.Item(SPEAKER_IO_43).dw2 = 1
  46.     hSPEAKER.cardReg.Card.Item(SPEAKER_IO_61).Item = ITEM_IO
  47.     hSPEAKER.cardReg.Card.Item(SPEAKER_IO_61).fNotSharable = False
  48.     hSPEAKER.cardReg.Card.Item(SPEAKER_IO_61).dw1 = SPEAKER_IO_ADDR61
  49.     hSPEAKER.cardReg.Card.Item(SPEAKER_IO_61).dw2 = 1
  50. End Sub
  51.  
  52. Function SPEAKER_Open(hSPEAKER As SPEAKER_HANDLE) As Boolean
  53. Dim ver As WD_VERSION
  54.    hSPEAKER.cardReg.hCard = 0
  55.    hSPEAKER.hWD = INVALID_HANDLE_VALUE
  56.    hSPEAKER.hWD = WD_Open()
  57.       If hSPEAKER.hWD = INVALID_HANDLE_VALUE Then
  58.          SPEAKER_ErrorString = "ERROR - Cannot open WinDriver device"
  59.          GoTo Error
  60.       End If
  61.       ' check if handle valid & version OK
  62.    WD_Version hSPEAKER.hWD, ver
  63.    If ver.dwVer < WD_VER Then
  64.       SPEAKER_ErrorString = "ERROR - incorrect WinDriver version"
  65.       GoTo Error
  66.    End If
  67.    SPEAKER_SetCardElements hSPEAKER
  68.    hSPEAKER.cardReg.fCheckLockOnly = False
  69.    WD_CardRegister hSPEAKER.hWD, hSPEAKER.cardReg
  70.    If (hSPEAKER.cardReg.hCard = 0) Then
  71.       SPEAKER_ErrorString = "ERROR - could not lock device"
  72.       GoTo Error
  73.    End If
  74.           'open finished OK
  75.    SPEAKER_Open = True
  76.    GoTo finish
  77. Error:
  78.           'error during open
  79.    If (hSPEAKER.cardReg.hCard <> 0) Then
  80.       WD_CardUnregister hSPEAKER.hWD, hSPEAKER.cardReg
  81.    End If
  82.    If (hSPEAKER.hWD <> INVALID_HANDLE_VALUE) Then
  83.       WD_Close hSPEAKER.hWD
  84.    End If
  85.    SPEAKER_Open = False
  86. finish:
  87. End Function
  88.  
  89. Sub SPEAKER_Close(hSPEAKER As SPEAKER_HANDLE)
  90.    ' unregister card
  91.    If (hSPEAKER.cardReg.hCard <> 0) Then
  92.       WD_CardUnregister hSPEAKER.hWD, hSPEAKER.cardReg
  93.    End If
  94.    ' close WinDriver
  95.    WD_Close (hSPEAKER.hWD)
  96. End Sub
  97.  
  98. Sub SPEAKER_WriteCtrl(hSPEAKER As SPEAKER_HANDLE, data As Byte)
  99. Dim trans As WD_TRANSFER
  100.    trans.cmdTrans = WP_BYTE
  101.    trans.dwPort = SPEAKER_IO_ADDR61
  102.    trans.dwDataTransfer = data
  103.    WD_Transfer hSPEAKER.hWD, trans
  104. End Sub
  105.  
  106. Function SPEAKER_ReadCtrl(hSPEAKER As SPEAKER_HANDLE) As Byte
  107. Dim trans As WD_TRANSFER
  108.     trans.cmdTrans = RP_BYTE
  109.     trans.dwPort = SPEAKER_IO_ADDR61
  110.     WD_Transfer hSPEAKER.hWD, trans
  111.     SPEAKER_ReadCtrl = trans.dwDataTransfer
  112. End Function
  113.  
  114. Sub SPEAKER_WriteTimerData(hSPEAKER As SPEAKER_HANDLE, data As Byte)
  115. Dim trans As WD_TRANSFER
  116.    trans.cmdTrans = WP_BYTE
  117.    trans.dwPort = SPEAKER_IO_ADDR42
  118.    trans.dwDataTransfer = data
  119.    WD_Transfer hSPEAKER.hWD, trans
  120. End Sub
  121.  
  122. Sub SPEAKER_WriteTimerCtrl(hSPEAKER As SPEAKER_HANDLE, data As Byte)
  123. Dim trans As WD_TRANSFER
  124.    trans.cmdTrans = WP_BYTE
  125.    trans.dwPort = SPEAKER_IO_ADDR43
  126.    trans.dwDataTransfer = data
  127.    WD_Transfer hSPEAKER.hWD, trans
  128. End Sub
  129.  
  130. Sub SPEAKER_Tone(hSPEAKER As SPEAKER_HANDLE, dwHz As Long, dwMilli As Long)
  131. Dim dwDevisor As Long
  132. Dim bCtrl As Byte
  133.    dwDevisor = 1190000 \ dwHz
  134.    SPEAKER_WriteTimerCtrl hSPEAKER, &HB6
  135.    SPEAKER_WriteTimerData hSPEAKER, dwDevisor And &HFF
  136.    SPEAKER_WriteTimerData hSPEAKER, ((dwDevisor \ 2 ^ 8) And &HFF)
  137.    bCtrl = SPEAKER_ReadCtrl(hSPEAKER)
  138.    SPEAKER_WriteCtrl hSPEAKER, bCtrl Or (bit0 Or bit1)
  139.    Sleep (dwMilli)
  140.    SPEAKER_WriteCtrl hSPEAKER, bCtrl And Not (bit0 Or bit1)
  141. End Sub
  142.  
  143.